---
title: "Tidy Tuesday #3: Global Mortality"
author: "Thomas John Flaherty"
output: 
  flexdashboard::flex_dashboard:
    orientation: rows
    social: menu
    theme: lumen
    source_code: embed
---

```{r setup, message=F}
remove(list = ls(all.names = TRUE))

detachAllPackages <- function() {
  basic.packages.blank <-  c("stats","graphics","grDevices","utils","datasets","methods","base")
  basic.packages <- paste("package:", basic.packages.blank, sep = "")
  package.list <- search()[ifelse(unlist(gregexpr("package:", search())) == 1,TRUE,FALSE)]
  package.list <- setdiff(package.list, basic.packages)
  if (length(package.list) > 0)  for (package in package.list) {
    detach(package, character.only = TRUE)}}

detachAllPackages()

knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE, dpi = 144, fig.align = "center")

if (!require(pacman)) {
  install.packages("pacman")
  require(pacman)
}

p_load(knitr, httr, noncensus, readxl, flexdashboard, viridis, crosstalk, DT, raster, tidyverse)

p_load_gh("jbkunst/highcharter")

color_from_middle <- function (data, color1,color2) 
{
  max_val=max(abs(data))
  JS(sprintf("isNaN(parseFloat(value)) || value < 0 ? 'linear-gradient(90deg, transparent, transparent ' + (50 + value/%s * 50) + '%%, %s ' + (50 + value/%s * 50) + '%%,%s  50%%,transparent 50%%)': 'linear-gradient(90deg, transparent, transparent 50%%, %s 50%%, %s ' + (50 + value/%s * 50) + '%%, transparent ' + (50 + value/%s * 50) + '%%)'",
             max_val,color2,max_val,color2,color1,color1,max_val,max_val))
}
```

```{r}
# path <- "https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/global_mortality.xlsx"
# 
# try(GET(path, write_disk(tf <- tempfile(fileext = ".xlsx"))), silent = T)

path <- "~/Documents/GitHub/tidytuesday/data/2018-04-16/global_mortality.xlsx"

dat <- read_excel(path) %>%
  mutate_if(is.numeric, 
            funs(if_else(is.na(.), 0, .))) %>%
  group_by(country) %>%
  select(-3) %>%
  summarise_if(is.numeric, 
               funs(round(lm(. ~ c(1:27))$coeff[[2]], 3))) %>%
  gather(Stat, Value, -country) %>%
  mutate(Continent = ccodes()[match(country, ccodes()$NAME), 9],
         Stat = gsub(".[[:punct:]]", "", Stat)) %>%
  mutate_if(is.character, as.factor) %>%
  select(1,2,4,3) %>%
  na.omit() %>%
  droplevels() %>%
  arrange(desc(Value)) %>%
  {.}

#unlink(tf)

shared_dat <- SharedData$new(dat)
sd_df <- SharedData$new(dat, group = shared_dat$groupName())
```

Inputs {.sidebar}
-------------------------------------

Here's some really cool text where I talk about how I found the slope for each stat by using a time series linear regression in a `summarize_if()`. It's seriously super baller.

Now on to the data filtering! Nice!

```{r}
filter_select("Stat", "Mortality Statistic:", sd_df, ~Stat)
filter_checkbox("Continent", "Continent:", sd_df, ~Continent)
filter_slider("Value", "Overall Change:", sd_df, ~Value)
```

##

### 

```{r}
datatable(sd_df,
          colnames = c("Country", "Mortality Statistic", "Continent", "Overall Change"), 
          extensions = c('Scroller','Buttons'),
          plugins = 'natural',
          options = list(scrollY = 300, 
                         scroller = T, 
                         dom = 'Bfrtip',
                         buttons = c('colvis', 'copy', 'csv', 'excel', 'pdf', 'print'),
                         columnDefs = list(list(className = 'dt-center', type = 'natural'))),
          rownames = F, 
          fillContainer = T,
          class = 'cell-border stripe') %>%
  formatStyle("Value",
              background = color_from_middle(sd_df$data()$Value, 'lightblue', 'lightblue'),
              backgroundSize = '95% 50%',
              backgroundRepeat = 'no-repeat',
              backgroundPosition = 'center')
```